unit NTZPooling;

interface

uses
 {$IFDEF FPC}
  SysUtils, Classes, ZConnection, ZDbcIntfs, ZCompatibility;
 {$ELSE}
   {$IFNDEF VER180}
    SysUtils, Classes, ZConnection, ZDbcIntfs, ZCompatibility;
   {$ELSE}
    SysUtils, Classes, ZConnection, ZDbcIntfs, ZCompatibility, dbcommontypes;
   {$ENDIF}
 {$ENDIF}

type

  { TNTZPooling }

  TNTZPooling = class(TComponent)
  private
    { Private declarations }
  protected
    { Protected declarations }
    FAutoCommit,
    FLoginPrompt,
    FReadOnly,
    FSQLHourGlass,
    FKeepConnections: Boolean;
    FCatalog,
    FDatabase,
    FHostName,
    FPassword,
    FProtocol,
    FUser           : String;
    FPort           : Word;
    FProperties     : TStrings;
    FCount,
    FMaxConnections : Integer;
    FIsolationLevel : TZTransactIsolationLevel;
    FPool: TList;
    function  Add: TZConnection;
    function  GetCount: Integer;
    function  IndexOf(AConnection: TZConnection): Integer;
    procedure SetProperties(const AValue: TStrings);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function  GetConnection: TZConnection;
    procedure ReturnConnection(Aconnection: TZConnection);
    property Count: Integer
      read GetCount;
  published
    { Published declarations }
    property AutoCommit: Boolean
      read FAutoCommit write FAutoCommit default True;
    property Catalog: String
      read FCatalog write FCatalog;
    property Database: String
      read FDatabase write FDatabase;
    property HostName: String
      read FHostName write FHostName;
    property KeepConnections: Boolean
      read FKeepConnections write FKeepConnections default True;
    property LoginPrompt: Boolean
      read FLoginPrompt write FLoginPrompt default False;
    property MaxConnections: Integer
      read FMaxConnections write FMaxConnections default -1;
    property Password: String
      read FPassword write FPassword;
    property Port: Word
      read FPort write FPort;
    property Properties: TStrings
      read FProperties write SetProperties;
    property Protocol: String
      read FProtocol write FProtocol;
    property ReadOnly: Boolean
      read FReadOnly write FReadOnly default False;
    property TransactIsolationLevel: TZTransactIsolationLevel
      read FIsolationLevel write FIsolationLevel default tiNone;
    property User: String
      read FUser write FUser;
  end;

implementation

{ TNTZPooling }

constructor TNTZPooling.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutoCommit := True;
  FLoginPrompt := False;
  FReadOnly := False;
  FSQLHourGlass := False;
  FKeepConnections := True;
  FIsolationLevel := tiNone;
  FPort := 0;
  FProperties := TStringList.Create;
  FMaxConnections := -1;
  FPool := TList.Create;
  FCount := 0;
end;

destructor TNTZPooling.Destroy;
begin
  FPool.Clear;
  FreeAndNil(FPool);
  inherited Destroy;
end;

function TNTZPooling.GetConnection: TZConnection;
var
  i: Integer;
begin
  Result := nil;
  if FPool.Count = 0 then
    Result := Add
  else
    begin
      for i := 0 to FPool.Count - 1 do
      begin
        if not (TObject(FPool[i]) as TZConnection).Connected then
        begin
          Result := (TObject(FPool[i]) as TZConnection);
          Exit;
        end;
        if (FPool.Count < FMaxConnections) or (FMaxConnections = -1) then
          Result := Add;
      end;
    end;
end;

procedure TNTZPooling.ReturnConnection(AConnection: TZConnection);
begin
  AConnection.Disconnect;

  if KeepConnections then
    (TObject(FPool[IndexOf(AConnection)]) as TZConnection).Disconnect
  else
    FPool.Delete(IndexOf(AConnection));
end;

procedure TNTZPooling.SetProperties(const AValue: TStrings);
begin
  if AValue <> nil then
    FProperties.Text := AValue.Text
  else
    FProperties.Clear;
end;

function TNTZPooling.Add: TZConnection;
begin
  FPool.Add(TZConnection.Create(nil));
  Result := (TObject(FPool[FPool.Count - 1]) as TZConnection);
  Result.AutoCommit := FAutoCommit;
  Result.Catalog := FCatalog;
  Result.Database := FDatabase;
  Result.DesignConnection := False;
  Result.HostName := FHostName;
  Result.LoginPrompt := FLoginPrompt;
  Result.Name := 'ZConnection' + IntToStr(FCount);
  Result.Password := FPassword;
  Result.Port := FPort;
  Result.Properties := FProperties;
  Result.Protocol := FProtocol;
  Result.ReadOnly := FReadOnly;
  Result.SQLHourGlass := FSQLHourGlass;
  Result.TransactIsolationLevel := FIsolationLevel;
  Result.User := FUser;
  inc(FCount);
end;

function TNTZPooling.GetCount: Integer;
begin
  Result := FPool.Count;
end;

function TNTZPooling.IndexOf(AConnection: TZConnection): Integer;
begin
  for Result := 0 to Pred(FPool.Count) do
    if (TObject(FPool[Result]) as TZConnection).Name = AConnection.Name then
      Exit;

  Result := -1;
end;

end.
